home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Ham Radio
/
Ham Radio CD-ROM (Emerald Software) (1995).ISO
/
misc
/
hamutil1
/
morse2.bas
< prev
next >
Wrap
BASIC Source File
|
1985-03-13
|
5KB
|
104 lines
5 'DDDDDDDVariable-speed Morse code
6 'generator programmed by Dick Conklin
7 'MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
10 WIDTH 40:KEY OFF:KEY 1,"":KEY 3,"": KEY 4,"":DEF SEG:POKE 106,0:CLS:S=.5:F=1000
12 KEY 2,"CQ CQ de N4AT "
15 ' F=1000:LOCATE 5,11:MSG$="Morse Code Generator":GOSUB 500:F=900:LOCATE 10,6:MSG$="Written by Dick Conklin, N4AT":GOSUB 500:F=800:LOCATE 15,9:MSG$="Variable Speed and Pitch":GOSUB 500
20 CLS:LOCATE 7,15:PRINT "Select Code Speed:"
25 LOCATE 8,15:PRINT "(words per minute)"
30 LOCATE 12,15:PRINT "5 Slow"
40 LOCATE 14,15:PRINT "13"
50 LOCATE 16,15:PRINT "25"
60 LOCATE 18,15:PRINT "40 Fast"
65 LOCATE 21,15:PRINT "99 EXIT PROGRAM"
70 LOCATE 23,25:PRINT "(Press ENTER)"
80 LOCATE 23,15:INPUT "",W:IF W=0 THEN W=20
81 IF W=99 THEN END
82 S=21/W
85 CLS:INPUT "Do you want to create a new file";Q$:IF Q$="y" THEN GOSUB 3200
87 INPUT "Do you want to convert a file into code";Q$:IF Q$="y" THEN GOSUB 3000:GOTO 20
90 CLS:LOCATE 25,1:PRINT "F1=Restart F3=Lower Tone, F4=Higher ";:LOCATE 1,1:PRINT "Text typed below sent at ";W;" WPM:":LOCATE 3,1,1
100 I$=INKEY$:IF I$="" THEN 100
110 GOSUB 1000
120 GOTO 100
499 'MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
500 'Message Sender
510 FOR I=1 TO LEN(MSG$)
520 I$=MID$(MSG$,I,1):GOSUB 1000
530 NEXT I
540 RETURN 'to Sender
999 'MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
1000 'Code Generator
1005 C$=CHR$(ASC(I$) OR 32)
1010 IF C$="a" THEN B$=".-":GOTO 2000
1020 IF C$="b" THEN B$="-...":GOTO 2000
1030 IF C$="c" THEN B$="-.-.":GOTO 2000
1040 IF C$="d" THEN B$="-..":GOTO 2000
1050 IF C$="e" THEN B$=".":GOTO 2000
1060 IF C$="f" THEN B$="..-.":GOTO 2000
1070 IF C$="g" THEN B$="--.":GOTO 2000
1080 IF C$="h" THEN B$="....":GOTO 2000
1090 IF C$="i" THEN B$="..":GOTO 2000
1100 IF C$="j" THEN B$=".---":GOTO 2000
1110 IF C$="k" THEN B$="-.-":GOTO 2000
1120 IF C$="l" THEN B$=".-..":GOTO 2000
1130 IF C$="m" THEN B$="--":GOTO 2000
1140 IF C$="n" THEN B$="-.":GOTO 2000
1150 IF C$="o" THEN B$="---":GOTO 2000
1160 IF C$="p" THEN B$=".--.":GOTO 2000
1170 IF C$="q" THEN B$="--.-":GOTO 2000
1180 IF C$="r" THEN B$=".-.":GOTO 2000
1190 IF C$="s" THEN B$="...":GOTO 2000
1200 IF C$="t" THEN B$="-":GOTO 2000
1210 IF C$="u" THEN B$="..-":GOTO 2000
1220 IF C$="v" THEN B$="...-":GOTO 2000
1230 IF C$="w" THEN B$=".--":GOTO 2000
1240 IF C$="x" THEN B$="-..-":GOTO 2000
1250 IF C$="y" THEN B$="-.--":GOTO 2000
1260 IF C$="z" THEN B$="--..":GOTO 2000
1270 IF C$="1" THEN B$=".----":GOTO 2000
1280 IF C$="2" THEN B$="..---":GOTO 2000
1290 IF C$="3" THEN B$="...--":GOTO 2000
1300 IF C$="4" THEN B$="....-":GOTO 2000
1310 IF C$="5" THEN B$=".....":GOTO 2000
1320 IF C$="6" THEN B$="-....":GOTO 2000
1330 IF C$="7" THEN B$="--...":GOTO 2000
1340 IF C$="8" THEN B$="---..":GOTO 2000
1350 IF C$="9" THEN B$="----.":GOTO 2000
1360 IF C$="0" THEN B$="-----":GOTO 2000
1370 IF C$="." THEN B$=".-.-.-":GOTO 2000
1380 IF C$="?" THEN B$="..--..":GOTO 2000
1390 IF C$="," THEN B$="--..--":GOTO 2000
1400 IF C$="-" THEN B$="-...-":GOTO 2000
1410 IF C$="/" THEN B$="-..-.":GOTO 2000
1420 IF I$=" " THEN B$=" ":GOTO 2000
1500 FK=MID$(I$,1,1)=CHR$(0) : F1=MID$(I$,2,1)=CHR$(59) : F3=MID$(I$,2,1)=CHR$(61) : F4=MID$(I$,2,1)=CHR$(62)
1510 IF FK AND F3 THEN F=F-10 ELSE IF FK AND F4 THEN F=F+10 ELSE IF FK AND F1 THEN 20
1520 IF I$=CHR$(8) THEN B$="........": LOCATE ,POS(0)-1:PRINT " ";: LOCATE ,POS(0)-1:C$="":GOTO 2000
1530 IF I$=":" THEN B$="---...": GOTO 2000
1540 IF I$=";" THEN B$="-.-.-.": GOTO 2000
1550 IF I$="(" OR C$=")" THEN B$="-.--.-":GOTO 2000
1560 IF I$="+" OR I$="&" THEN B$=". ...":GOTO 2000
1990 C$="" :B$="":I$=""
2000 PRINT I$; 'Display while sending
2010 FOR C=1 TO LEN(B$)
2020 IF MID$(B$,C,1)="." THEN SOUND F,S ELSE IF MID$(B$,C,1)="-" THEN SOUND F,S*3 ELSE SOUND 32767,S*1
2025 SOUND 32767,S 'Space after Dot/Dash
2030 NEXT C 'Get the next Dot or Dash
2035 SOUND 32767,S*1.5 'Space after letter
2040 RETURN 'Get the next letter
3000 'Convert text file into code
3005 ON ERROR GOTO 3010:PRINT "Current files: ";:FILES "*. ":PRINT
3010 INPUT "Enter file name: ",CODEFILE$
3020 OPEN CODEFILE$+". " FOR INPUT AS #1
3030 CLS:LOCATE 25,1:PRINT "Reading from file ";CODEFILE$:LOCATE 1,1:PRINT "Text typed below sent at ";W;" WPM":LOCATE 3,1
3040 IF EOF(1) THEN CLOSE:RETURN
3050 INPUT #1,MSG$:GOSUB 500:PRINT:GOTO 3040
3200 'Enter and store text
3205 ON ERROR GOTO 3210:PRINT "Current files: ";:FILES "*. ":PRINT
3210 INPUT "Enter file name: ",CODEFILE$:OPEN CODEFILE$+". " FOR OUTPUT AS #1
3215 CLS:LOCATE 25,1:PRINT "Enter ";CHR$(17);"DDY when done":LOCATE 1,1:PRINT "Enter text to be stored below:"
3220 LINE INPUT TEXT$
3230 IF TEXT$="" THEN CLOSE:RETURN
3240 PRINT #1,CHR$(34);TEXT$;" ";CHR$(34):GOTO 3220